home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / b / b.lha / B / src / bint / b3scr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1988-11-24  |  11.8 KB  |  492 lines
  1. /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
  2.  
  3. /*
  4.   $Header: b3scr.c,v 1.4 85/08/22 16:58:54 timo Exp $
  5. */
  6.  
  7. /* B input/output handling */
  8.  
  9. #include "b.h"
  10. #include "b0fea.h"
  11. #include "b1mem.h"
  12. #include "b1obj.h"
  13. #include "b0con.h" /*for CLEAR_EOF*/
  14. #include "b2nod.h"
  15. #include "b2syn.h"
  16. #include "b2par.h"
  17. #include "b3scr.h"
  18. #include "b3err.h"
  19. #include "b3fil.h"
  20. #include "b3typ.h"
  21. #include "b3env.h"
  22. #include "b3sem.h"
  23. #include "b3int.h"
  24. #ifdef SETJMP
  25. #include <setjmp.h>
  26. #endif
  27.  
  28. Visible bool interactive;
  29. Visible bool rd_interactive;
  30. Visible value iname= Vnil;    /* input name */
  31. Visible bool filtered= No;
  32. Visible bool outeractive;
  33. #ifdef SETJMP
  34. Visible bool awaiting_input= No;
  35. Visible jmp_buf read_interrupt;
  36. #endif
  37. Visible bool at_nwl= Yes;    /*Yes if currently at the start of an output line*/
  38. Hidden bool woa, wnwl;        /*was outeractive, was at_nwl */
  39. Hidden bool last_was_text= No;    /*Yes if last value written was a text*/
  40.  
  41. Visible bool Eof;
  42. FILE *ofile= stdout;
  43. FILE *ifile;         /* input file */
  44. FILE *sv_ifile;        /* copy of ifile for restoring after reading unit */
  45.  
  46. /******************************* Output *******************************/
  47.  
  48. #ifndef INTEGRATION
  49.  
  50. Hidden Procedure putch(c) char c; {
  51.     if (still_ok) {
  52.         putc(c, ofile);
  53.         if (c == '\n') at_nwl= Yes;
  54.         else at_nwl= No;
  55.     }
  56. }
  57.  
  58. #else
  59.  
  60. Hidden int ocol;    /* Current output column */
  61.  
  62. Hidden Procedure putch(c) char c; {
  63.     if (still_ok) {
  64.         putc(c, ofile);
  65.         if (c == '\n') { at_nwl= Yes; ocol= 0; }
  66.         else {
  67.             if (at_nwl) { ocol= 0; at_nwl= No;}
  68.             ++ocol;
  69.         }
  70.     }
  71. }
  72.  
  73. #endif
  74.  
  75. Visible Procedure newline() {
  76.     putch('\n');
  77.     fflush(stdout);
  78. }
  79.  
  80. Hidden Procedure line() {
  81.     if (!at_nwl) newline();
  82. }
  83.  
  84. Visible Procedure wri_space() {
  85.     putch(' ');
  86. }
  87.  
  88. Visible Procedure writ(v) value v; {
  89.     wri(v, Yes, Yes, No);
  90.     fflush(stdout);
  91. }
  92.  
  93. #define Putch_sp() {if (!perm) putch(' ');}
  94.  
  95. Hidden int intsize(v) value v; {
  96.     value s= size(v); int len=0;
  97.     if (large(s)) error(MESS(3800, "value too big to output"));
  98.     else len= intval(s);
  99.     release(s);
  100.     return len;
  101. }
  102.  
  103. Hidden bool lwt;
  104.  
  105. Visible Procedure wri(v, coll, outer, perm) value v; bool coll, outer, perm; {
  106.     if (outer && !at_nwl && (!Is_text(v) || !last_was_text)
  107.           && (!Is_compound(v) || !coll)) putch(' ');
  108.     lwt= No;
  109.     if (Is_number(v)) {
  110.         if (perm) printnum(ofile, v);
  111.         else {
  112.             string cp= convnum(v);
  113.             while(*cp && still_ok) putch(*cp++);
  114.         }
  115.     } else if (Is_text(v)) {
  116. #ifndef INTEGRATION
  117.         wrtext(putch, v, outer ? '\0' : '"');
  118. #else
  119.         value ch; char c; int k, len= Length(v);
  120. #define QUOTE '"'
  121.         if (!outer) putch(QUOTE);
  122.         for (k=0; k<len && still_ok; k++) {
  123.             ch= thof(k+1, v);
  124.             putch(c= charval(ch));
  125.             if (!outer && (c == QUOTE || c == '`'))
  126.                 putch(c);
  127.             release(ch);
  128.         }
  129.         if (!outer) putch(QUOTE);
  130. #endif
  131.         lwt= outer;
  132.     } else if (Is_compound(v)) {
  133.         intlet k, len= Nfields(v);
  134.         outer&= coll;
  135.         if (!coll) putch('(');
  136.         for (k=0; k<len && still_ok; k++) {
  137.             wri(*Field(v, k), No, outer, perm);
  138.             if (!Lastfield(k)) {
  139.                 if (!outer){
  140.                     putch(',');
  141.                     Putch_sp();
  142.                 }
  143.             }
  144.         }
  145.         if (!coll) putch(')');
  146.     } else if (Is_list(v) || Is_ELT(v)) {
  147.         value ve; int k, len= intsize(v);
  148.         putch('{');
  149.         for (k=0; k<len && still_ok; k++) {
  150.             wri(ve= thof(k+1, v), No, No, perm);
  151.             release(ve);
  152.             if (!Last(k)) {
  153.                 putch(';');
  154.                 Putch_sp();
  155.             }
  156.         }
  157.         putch('}');
  158.     } else if (Is_table(v)) {
  159.         int k, len= intsize(v);
  160.         putch('{');
  161.         for (k=0; k<len && still_ok; k++) {
  162.             putch('['); wri(*key(v, k), Yes, No, perm);
  163.             putch(']'); putch(':'); Putch_sp();
  164.             wri(*assoc(v, k), No, No, perm);
  165.             if (!Last(k)) {
  166.                 putch(';');
  167.                 Putch_sp();
  168.             }
  169.         }
  170.         putch('}');
  171.     } else {
  172.         if (bugs || testing) { putch('?'); putch(Type(v)); putch('?'); }
  173.         else syserr(MESS(3801, "writing value of unknown type"));
  174.     }
  175.     last_was_text= lwt;
  176. #ifdef IBMPC
  177.     if (interrupted) clearerr(ofile);
  178. #endif
  179. }
  180.  
  181. /***************************** Input ****************************************/
  182.  
  183. Hidden char cmbuf[CMBUFSIZE]; /* for commands */
  184. Hidden char rdbuf[RDBUFSIZE]; /* for READ EG/RAW */
  185.  
  186. #ifndef INTEGRATION
  187. Visible string cmd_prompt= ">>> "; /* commands  */
  188. Visible string eg_prompt=  "?\b";  /* READ EG   */
  189. Visible string raw_prompt= "?\b";  /* READ RAW  */
  190. Visible string qn_prompt=  "?\b";  /* questions */
  191. #else
  192. Hidden literal cmd_prompt= '>'; /* commands  */
  193. Hidden literal eg_prompt=  'E';  /* READ EG   */
  194. Hidden literal raw_prompt= 'R';  /* READ RAW  */
  195. Hidden literal qn_prompt= 'Y';  /* questions */
  196. Visible literal unit_prompt= ':'; /* units */
  197. Visible literal tar_prompt= '='; /* targets */
  198. #endif
  199.  
  200. /* Read a line; EOF only allowed if not interactive, in which case eof set */
  201. /* Returns the line input                                                  */
  202. /* This is the only place where a long jump is necessary                   */
  203. /* In other places, interrupts are just like procedure calls, and checks   */
  204. /* of still_ok and interrupted suffice: eventually the stack unwinds to the*/
  205. /* main loop in imm_command(). Here though, an interrupt must actually     */
  206. /* terminate the read. Hence the bool awaiting_input indicating if the     */
  207. /* long jump is necessary or not                                           */
  208.  
  209. #ifndef INTEGRATION
  210.  
  211. Hidden txptr read_line(should_prompt, prompt, cmd, eof, eof_message)
  212.  bool should_prompt, cmd, *eof; string prompt, eof_message; {
  213.     txptr buf, rp, bufend; intlet k; bool got= No;
  214.     FILE *f;
  215.     *eof= No;
  216.     if (cmd) { buf= cmbuf; bufend= &cmbuf[CMBUFSIZE-2]; }
  217.     else     { buf= rdbuf; bufend= &rdbuf[RDBUFSIZE-2]; }
  218. #ifdef SETJMP
  219.     if (setjmp(read_interrupt) != 0) {
  220.         awaiting_input= No;
  221.         return buf;
  222.     }
  223. #endif
  224.     while (!got) {
  225.         rp= buf;
  226. #ifdef SETJMP
  227.         awaiting_input= Yes;
  228. #endif
  229.         if (should_prompt) {
  230.             if (cmd) {
  231.                 if (outeractive) {
  232.                     line();
  233.                     at_nwl= No;
  234.                 }
  235.             }
  236.             fprintf(stderr, prompt); fflush(stderr);
  237.             f= stdin;
  238.         } else {
  239.             f= ifile;
  240.         }
  241.         while ((k= getc(f)) != EOF && k != '\n') {
  242.             *rp++= k;
  243.             if (rp >= bufend) syserr(MESS(3802, "buffer overflow"));
  244.         }
  245. #ifdef SETJMP
  246.         awaiting_input= No;
  247. #endif
  248.         got= Yes; *rp++= '\n'; *rp= '\0';
  249.         if (k == EOF) {
  250.             if (should_prompt) {
  251.                 if (filtered) {
  252.                     bye(0); /*Editor has died*/
  253.                 } else {
  254.                     fprintf(stderr, "\r*** %s\n", eof_message);
  255.                     CLEAR_EOF;
  256.                     if (outeractive) at_nwl= Yes;
  257.                     got= No;
  258.                 }
  259.             } else *eof= Yes;
  260.         }
  261.     }
  262.     if (should_prompt && outeractive && k == '\n') at_nwl= Yes;
  263.     return buf;
  264. }
  265.  
  266. #else INTEGRATION
  267.  
  268. Hidden intlet
  269. rd_fileline(nbuf, file, nbufend)
  270.     string nbuf, nbufend;
  271.     FILE *file;
  272. {
  273.     intlet k;
  274.     while ((k= getc(file)) != EOF && k != '\n') {
  275.         *nbuf++= k;
  276.         if (nbuf >= nbufend)
  277.             syserr(MESS(3803, "buffer overflow rd_fileline()"));
  278.     }
  279.     *nbuf++= '\n'; *nbuf= '\0';
  280.     return k;
  281. }
  282.  
  283. Hidden intlet
  284. rd_bufline(nbuf, obuf, nbufend)
  285.     string nbuf, *obuf, nbufend;
  286. {
  287.     while (**obuf && **obuf != '\n') {
  288.         *nbuf++= **obuf; ++*obuf;
  289.         if (nbuf >= nbufend)
  290.             syserr(MESS(3804, "buffer overflow rd_bufline()"));
  291.     }
  292.     *nbuf++= '\n'; *nbuf= '\0';
  293.     if (**obuf)  { ++*obuf; return '\n';}
  294.     else return EOF;
  295. }
  296.  
  297. Hidden string edcmdbuf;
  298.  
  299. Hidden txptr
  300. read_line(should_prompt, prompt, cmd, eof, eof_message)
  301.     bool should_prompt, cmd, *eof; literal prompt; string eof_message;
  302. {
  303.     txptr buf, rp, bufend; intlet k, indent= 0; bool got= No;
  304.     static string pedcmdbuf;
  305.     if (prompt == eg_prompt || prompt == raw_prompt) indent= ocol;
  306.     *eof= No;
  307.     if (cmd) { buf= cmbuf; bufend= &cmbuf[CMBUFSIZE-2]; }
  308.     else     { buf= rdbuf; bufend= &rdbuf[RDBUFSIZE-2]; }
  309. #ifdef SETJMP
  310.     if (setjmp(read_interrupt) != 0) {
  311.         awaiting_input= No;
  312.         return buf;
  313.     }
  314. #endif
  315.     while (!got) {
  316.         rp= buf; got= Yes;
  317. #ifdef SETJMP
  318.         awaiting_input= Yes;
  319. #endif
  320.         if (!should_prompt) {
  321.             k= rd_fileline(rp, ifile, bufend);
  322.             if (k == EOF) *eof= Yes;
  323.         } else {
  324.             if (!edcmdbuf) {
  325.                 if (cmd && outeractive) { line(); at_nwl= No; }
  326.                 btop(&edcmdbuf, 0, prompt, indent);
  327.                 pedcmdbuf= edcmdbuf;
  328.             }
  329.             k= rd_bufline(rp, &pedcmdbuf, bufend);
  330.             if (k == EOF) {
  331.                 freemem((ptr) edcmdbuf);
  332.                 edcmdbuf= (string) NULL;
  333.                 if (prompt != '>') got= No;
  334.             } 
  335.         }
  336. #ifdef SETJMP
  337.         awaiting_input= No;
  338. #endif
  339.     }
  340.  
  341.     if (should_prompt && outeractive && k == '\n') at_nwl= Yes;
  342.     return buf;
  343. }
  344.  
  345. #endif INTEGRATION
  346.  
  347. /* Rather over-fancy routine to ask the user a question */
  348. /* Will anybody discover that you're only given 4 chances? */
  349.  
  350. Hidden char USE_YES_OR_NO[]=
  351.  "Answer with yes or no (or use interrupt to duck the question)";
  352.  
  353. Hidden char LAST_CHANCE[]=
  354.  "This is your last chance. Take it. I really don't know what you want.\n\
  355.     So answer the question";
  356.  
  357. Hidden char NO_THEN[]=
  358.  "Well, I shall assume that your refusal to answer the question means no!";
  359.  
  360. Visible bool is_intended(m) string m; {
  361.     char answer; intlet try; txptr tp; bool eof;
  362.     if (!interactive) return Yes;
  363.     if (outeractive) line();
  364.     for (try= 1; try<=4; try++){
  365.         if (try == 1 || try == 3) fprintf(stderr, "*** %s\n", m);
  366.         tp= read_line(Yes, qn_prompt, No, &eof, USE_YES_OR_NO);
  367.         skipsp(&tp);
  368.         answer= Char(tp);
  369.         if (answer == 'y' || answer == 'Y') return Yes;
  370.         if (answer == 'n' || answer == 'N') return No;
  371.         if (outeractive) line();
  372.         fprintf(stderr, "*** %s\n",
  373.             try == 1 ? "Please answer with yes or no" :
  374.             try == 2 ? "Just yes or no, please" :
  375.             try == 3 ? LAST_CHANCE :
  376.             NO_THEN);
  377.     } /* end for */
  378.     return No;
  379. }
  380.  
  381. /* Read_eg uses evaluation but it shouldn't.
  382.    Wait for a more general mechanism. */
  383.  
  384. Visible Procedure read_eg(l, t) loc l; btype t; {
  385.     context c; parsetree code;
  386.     parsetree r= NilTree; value rv= Vnil; btype rt= Vnil;
  387.     envtab svprmnvtab= Vnil;
  388.     txptr fcol_save= first_col, tx_save= tx;
  389.     do {
  390.         still_ok= Yes;
  391.         sv_context(&c);
  392.         if (cntxt != In_read) {
  393.             release(read_context.uname);
  394.             sv_context(&read_context);
  395.         }
  396.         svprmnvtab= prmnvtab == Vnil ? Vnil : prmnv->tab;
  397.         /* save scratch-pad copy because of following setprmnv() */
  398.         setprmnv();
  399.         cntxt= In_read;
  400.         first_col= tx= read_line(rd_interactive, eg_prompt, No,
  401.             &Eof, "use interrupt to abort READ command");
  402.         if (still_ok && Eof)
  403.             error(MESS(3805, "End of file encountered during READ command"));
  404.         if (!rd_interactive) f_lino++;
  405.         if (still_ok) {
  406.             findceol();
  407.             r= expr(ceol);
  408.             if (still_ok) fix_nodes(&r, &code);
  409.             rv= evalthread(code); release(r);
  410.             rt= still_ok ? valtype(rv) : Vnil;
  411.             if (svprmnvtab != Vnil) {
  412.                 prmnvtab= prmnv->tab;
  413.                 prmnv->tab= svprmnvtab;
  414.             }
  415.             set_context(&c);
  416.             if (still_ok) must_agree(t, rt,
  417.     MESS(3806, "type of expression does not agree with that of EG sample"));
  418.             release(rt);
  419.         }
  420.         if (!still_ok && rd_interactive && !interrupted)
  421.             fprintf(stderr, "*** Please try again\n");
  422.     } while (!interrupted && !still_ok && rd_interactive);
  423.     if (still_ok) put(rv, l);
  424.     first_col= fcol_save;
  425.     tx= tx_save;
  426.     release(rv);
  427. }
  428.  
  429. Visible Procedure read_raw(l) loc l; {
  430.     value r; bool eof;
  431.     txptr line= read_line(rd_interactive, raw_prompt, No, &eof, 
  432.             "use interrupt to abort READ t RAW");
  433.     if (still_ok && eof) error(MESS(3807, "End of file encountered during READ t RAW"));
  434.     if (!rd_interactive) f_lino++;
  435.     if (still_ok) {
  436.         txptr rp= line;
  437.         while (*rp != '\n') rp++;
  438.         *rp= '\0';
  439.         r= mk_text(line);
  440.         put(r, l);
  441.         release(r);
  442.     }
  443. }
  444.  
  445. Visible txptr getline() {
  446.     bool should_prompt=
  447.         interactive && sv_ifile == ifile;
  448.     return read_line(should_prompt, cmd_prompt, Yes, &Eof,
  449.             "use QUIT to end session");
  450. }
  451.  
  452. /******************************* Files ******************************/
  453.  
  454. Visible Procedure redirect(of) FILE *of; {
  455.     ofile= of;
  456.     if (of == stdout) {
  457.         outeractive= woa;
  458.         at_nwl= wnwl;
  459.     } else {
  460.         woa= outeractive; outeractive= No;
  461.         wnwl= at_nwl; at_nwl= Yes;
  462.     }
  463. }
  464.  
  465. Visible Procedure vs_ifile() {
  466.     ifile= sv_ifile;
  467. }
  468.  
  469. Visible Procedure re_screen() {
  470.     sv_ifile= ifile;
  471.     interactive= f_interactive(ifile) || (ifile == stdin && filtered);
  472.     Eof= No;
  473. }
  474.  
  475. /* initscr is a reserved name of CURSES */
  476. Visible Procedure init_scr() {
  477.     outeractive= f_interactive(stdout) || filtered;
  478.     rd_interactive= f_interactive(stdin) || filtered;
  479.     rdbuf[0]= '\n'; tx= rdbuf;
  480. }
  481.  
  482. Visible Procedure
  483. endscr()
  484. {
  485. #ifdef INTEGRATION
  486.     if (edcmdbuf) {
  487.         freemem((ptr) edcmdbuf);
  488.         edcmdbuf= (string) NULL;
  489.     }
  490. #endif
  491. }
  492.